Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/Bonus/Plasmatech/ptscp_eval.exe/%MAINDIR%/EvalD6/Reg_PTShellControls.pas

Pascal/Delphi Source File | 2001-08-31 | 19.4 KB | 572 lines

unit Reg_PTShellControls; // Copyright ⌐ 1996-2001 Plasmatech Software Design. All rights reserved.
{
 Shell Control Pack
 Version 1.6

 History
 ===================================================================================================
 V1.6   2Jul01 Delphi 6 release, added pane-selection menu items to TPTSplitter editor.
 V1.5c 30Mar01 No changes.
 V1.5b 12Dec00 No changes.
 V1.5a 14May00 No changes.
 V1.5   3Mar00 C++Builder 5 release.
 V1.4a 15Dec99 Added new property editor for TPTFrameStyle type, with custom drawing.
               Fixed some conditional compilation sections to match fix in PTCompVer.inc.
 V1.4  14Sep99 Added support for Delphi 5 categories.
 V1.3h 29Mar99 No changes.
 V1.3g  1Dec98 No changes.
 V1.3f 12Jul98 Delphi 4 release, no changes.
 V1.3e 22Apr98 Fixed TPTFolderBrowseDlgEditor.GetVerb.
 V1.3d 18Apr98 No changes.
 V1.3c 16Mar98 C++Builder 3 support.
 V1.3b  7Feb98 Changed default control page from 'Plasmatools' to 'Shell'.
 V1.3a  7Jan98 No changes.
 V1.3  28Nov97 No significant changes.
 V1.2b 12Oct97 No changes.
 V1.2a  5Oct97 No changes.
 V1.2   6Sep97 Fixed problem with TPTSplitter editor being registered twice.
 V1.1a  6Jul97 No changes.
 V1.1  26Jun97 Added UPTComControls unit and TPTTreeView and TPTListView components.
 V1.0c 31May97 Added TFilterProperty editor support to Delphi 3.
               Added TFilterProperty editor to Filter property of TPTShellList (Delphi 2 & 3).
 V1.0b 17May97 Changes to support Delphi 3.
 V1.0a  1May97 No changes.
 V1.0  21Apr97 Released version 1.0
}
{$INCLUDE PTCompVer.inc}

{$RANGECHECKS OFF} {$OVERFLOWCHECKS OFF} {$WRITEABLECONST OFF}
{$BOOLEVAL OFF}    {$EXTENDEDSYNTAX ON}  {$TYPEDADDRESS ON}

interface
uses UPTShell95, UPTShellUtils, UPTShellControls, UPTSysFolderDlg, UPTSplitter, UPTImageCombo,
     UPTFrame, UPTTreeList, UPTShConsts,
     FPTOpenDlg, FPTFolderBrowseDlg,
{$IFNDEF CBUILDER} {$IFNDEF DELPHI6}
     FiltEdit,
{$ENDIF} {$ENDIF}
     Dialogs, Forms;

procedure Register;

implementation
uses Classes, Controls, TypInfo,
{$IFDEF VCL50PLUS}
     Graphics, Windows,
{$ENDIF}
{$IFDEF VCL60PLUS}
     DesignIntf, DesignEditors, VCLEditors, PropertyCategories,
{$ELSE}
     DsgnIntf,
{$ENDIF}
     FPTShellLocatorEditor, FPTAbout;

const CTLPACK_PAGENAME  = 'Shell';
      CTLPACK_NAME      = 'Shell Control Pack';
      CTLPACK_COPYRIGHT = '1996-2001'#13#10;
      CTLPACK_VERSION   = PTSHELLCONTROLS_VERSION;
      CTLPACK_PATCH     = PTSHELLCONTROLS_PATCH;


const STest = '&Test...';
      SAbout = '&About...';
      SSwapPanes = 'Swap &Panes';
      SCenterPanes = '&Center Panes';
      SActivatePane1 = 'Activate Pane &1';
      SActivatePane2 = 'Activate Pane &2';


{$IFDEF VCL50PLUS}
{-- TPTFrameStyleProperty --------------------------------}

{$IFDEF VCL60PLUS}
type TPTFrameStyleProperty = class(TEnumProperty, ICustomPropertyListDrawing, ICustomPropertyDrawing)
     protected
       function GetImageWidth(ACanvas: TCanvas): Integer;

       {-- ICustomPropertyDrawing --}
       procedure PropDrawName(ACanvas: TCanvas; const ARect: TRect;
         ASelected: Boolean);
       procedure PropDrawValue(ACanvas: TCanvas; const ARect: TRect;
         ASelected: Boolean);

       {-- ICustomPropertyListDrawing --}
       procedure ListMeasureWidth(const Value: string; ACanvas: TCanvas; var AWidth: Integer);
       procedure ListMeasureHeight(const Value: string; ACanvas: TCanvas;
         var AHeight: Integer);
       procedure ListDrawValue(const Value: string; ACanvas: TCanvas; const ARect: TRect;
         ASelected: Boolean);
     end;
{$ELSE}
type TPTFrameStyleProperty = class(TEnumProperty)
     protected
       function GetImageWidth(ACanvas: TCanvas): Integer;
       procedure ListDrawValue(const Value: string; ACanvas: TCanvas; const ARect: TRect;
         ASelected: Boolean); override;
       procedure ListMeasureWidth(const Value: string; ACanvas: TCanvas; var AWidth: Integer);
         override;
       procedure PropDrawValue(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean); override;
     end;
{$ENDIF VCL60PLUS}


function TPTFrameStyleProperty.GetImageWidth(ACanvas: TCanvas): Integer;
begin
  Result := ACanvas.TextWidth('X')*2;
end;

procedure TPTFrameStyleProperty.ListDrawValue(const Value: string; ACanvas: TCanvas;
  const ARect: TRect; ASelected: Boolean);
var
  OrdValue: TPTFrameStyle;
  R: TRect;
  ImgWidth: Integer;
begin
  ImgWidth := GetImageWidth(ACanvas);
  {$IFDEF VCL60PLUS}
    DefaultPropertyListDrawValue(Value, ACanvas, Rect(ARect.Left+ImgWidth, ARect.Top, ARect.Right,
      ARect.Bottom), ASelected);
  {$ELSE}
    inherited ListDrawValue(Value, ACanvas, Rect(ARect.Left+ImgWidth, ARect.Top, ARect.Right,
      ARect.Bottom), ASelected);
  {$ENDIF VCL60PLUS}

  R := Rect(ARect.Left+2, ARect.Top+2, ARect.Left+ImgWidth -2, ARect.Bottom -2);

  ACanvas.Brush.Color := clBtnFace;
  ACanvas.FillRect(Rect(ARect.Left, ARect.Top, ARect.Left+ImgWidth, ARect.Bottom));

  OrdValue := TPTFrameStyle(GetEnumValue(TypeInfo(TPTFrameStyle), Value));

  UPTFrame.DrawFrame(OrdValue, ACanvas, R);
end;

procedure TPTFrameStyleProperty.ListMeasureWidth(const Value: string; ACanvas: TCanvas;
  var AWidth: Integer);
begin
  Inc(AWidth, GetImageWidth(ACanvas));
end;

{$IFDEF VCL60PLUS}
procedure TPTFrameStyleProperty.ListMeasureHeight(const Value: string; ACanvas: TCanvas; var AHeight: Integer);
begin
  // this space intenionally left blank
end;
{$ENDIF VCL60PLUS}

{$IFDEF VCL60PLUS}
procedure TPTFrameStyleProperty.PropDrawName(ACanvas: TCanvas; const ARect: TRect;
  ASelected: Boolean);
begin
  DefaultPropertyDrawName(Self, ACanvas, ARect);
end;
{$ENDIF VCL60PLUS}

procedure TPTFrameStyleProperty.PropDrawValue(ACanvas: TCanvas; const ARect: TRect;
  ASelected: Boolean);
begin
  ListDrawValue(GetVisualValue, ACanvas, ARect, ASelected);
end;
{$ENDIF VCL50PLUS}


{-- TPTShellLocatorEditor --------------------------------}

{ This is the property editor for design-time pidls. }
type TPTShellLocatorEditor = class(TClassProperty)
       procedure Edit; override;
       function GetAttributes: TPropertyAttributes; override;
     end;

function EditPidl( o: TPTShellLocator ): Boolean;
var f: TFrmShellLocatorEditor;
begin
  f := TFrmShellLocatorEditor.Create(Application);
  try
    f.Locator := o;
    result := (f.ShowModal = mrOk);
  finally
    f.Free;
  end;
end;

procedure TPTShellLocatorEditor.Edit;
begin
  if EditPidl( TPTShellLocator(GetOrdValue) ) then Modified;
end; {TPTShellLocatorEditor.Edit}

function TPTShellLocatorEditor.GetAttributes: TPropertyAttributes;
  begin result := [paDialog, paReadOnly]; end;
{=========================================================}



{-- TCSIDLEditor -----------------------------------------}
type TCSIDLEditor = class(TEnumProperty)
       procedure GetValues( proc: TGetStrProc ); override;
     end;

procedure TCSIDLEditor.GetValues( proc: TGetStrProc );
var i: Integer;
    enumType: PTypeInfo;
    s: String;
begin
  enumType := GetPropType;
  with GetTypeData(enumType)^ do
    for i := MinValue to MaxValue do
    begin
      s := GetEnumName(enumType, i);
      if Pos('_',s)=0 then
        Proc(s);
    end;
end; {TCSIDLEditor.GetValues}
{=========================================================}


{-- TPTAboutEditor ---------------------------------------}
type TPTAboutEditor = class(TDefaultEditor)
       procedure ExecuteVerb(index: Integer);  override;
       function GetVerb(index: Integer): String;  override;
       function GetVerbCount: Integer;  override;
     end;

procedure TPTAboutEditor.ExecuteVerb(index: Integer);
  begin FPTAbout.TPTFrmAbout.ExecuteCtl( CTLPACK_NAME, CTLPACK_COPYRIGHT, Component.ClassName, CTLPACK_VERSION, CTLPACK_PATCH ); end;

function TPTAboutEditor.GetVerb(index: Integer): String;
  begin result := SAbout; end;

function TPTAboutEditor.GetVerbCount: Integer;
  begin result := 1; end;
{== END TPTAboutEditor ===================================}


{-- TPTSysFolderDlgEditor --------------------------------}
type TPTSysFolderDlgEditor = class(TDefaultEditor)
       procedure ExecuteVerb(index: Integer);  override;
       function GetVerb(index: Integer): String;  override;
       function GetVerbCount: Integer;  override;
     end;

procedure TPTSysFolderDlgEditor.ExecuteVerb(index: Integer);
begin
  case index of
    0: FPTAbout.TPTFrmAbout.ExecuteCtl( CTLPACK_NAME, CTLPACK_COPYRIGHT, Component.ClassName, CTLPACK_VERSION, CTLPACK_PATCH );
    1: (Component as TPTSysFolderDlg).Execute;
  end;
end;

function TPTSysFolderDlgEditor.GetVerb(index: Integer): String;
begin
  case index of
    0: result := SAbout;
    1: result := STest;
  else
    result := '';
  end;
end;

function TPTSysFolderDlgEditor.GetVerbCount: Integer;
  begin result := 2; end;
{=========================================================}


{-- TPTFolderBrowseDlgEditor -----------------------------}
type TPTFolderBrowseDlgEditor = class(TDefaultEditor)
       procedure ExecuteVerb(index: Integer);  override;
       function GetVerb(index: Integer): String;  override;
       function GetVerbCount: Integer;  override;
     end;

procedure TPTFolderBrowseDlgEditor.ExecuteVerb(index: Integer);
begin
  case index of
    0: FPTAbout.TPTFrmAbout.ExecuteCtl( CTLPACK_NAME, CTLPACK_COPYRIGHT, Component.ClassName, CTLPACK_VERSION, CTLPACK_PATCH );
    1: (Component as TPTFolderBrowseDlg).Execute;
  end;
end;

function TPTFolderBrowseDlgEditor.GetVerb(index: Integer): String;
begin
  case index of
    0: result := SAbout;
    1: result := STest;
  else result := '';
  end;
end;

function TPTFolderBrowseDlgEditor.GetVerbCount: Integer; begin result := 2; end;
{=========================================================}


{-- TPTOpenDlgEditor -------------------------------------}
type TPTOpenDlgEditor = class(TDefaultEditor)
       procedure ExecuteVerb(index: Integer);  override;
       function GetVerb(index: Integer): String;  override;
       function GetVerbCount: Integer;  override;
     end;

procedure TPTOpenDlgEditor.ExecuteVerb(index: Integer);
begin
  case index of
    1: (Component as TPTOpenDlg).Execute;
    0: FPTAbout.TPTFrmAbout.ExecuteCtl( CTLPACK_NAME, CTLPACK_COPYRIGHT, Component.ClassName, CTLPACK_VERSION, CTLPACK_PATCH );
  end;
end;

function TPTOpenDlgEditor.GetVerb(index: Integer): String;
begin
  case index of
    1: result := STest;
    0: result := SAbout;
  else result := '';
  end;
end;

function TPTOpenDlgEditor.GetVerbCount: Integer;  begin result := 2; end;
{=========================================================}


{-- TPTSaveDlgEditor -------------------------------------}
type TPTSaveDlgEditor = class(TDefaultEditor)
       procedure ExecuteVerb(index: Integer);  override;
       function GetVerb(index: Integer): String;  override;
       function GetVerbCount: Integer;  override;
     end;

procedure TPTSaveDlgEditor.ExecuteVerb(index: Integer);
begin
  case index of
    1: (Component as TPTSaveDlg).Execute;
    0: FPTAbout.TPTFrmAbout.ExecuteCtl( CTLPACK_NAME, CTLPACK_COPYRIGHT, Component.ClassName, CTLPACK_VERSION, CTLPACK_PATCH );
  end;
end;

function TPTSaveDlgEditor.GetVerb(index: Integer): String;
begin
  case index of
    1: result := STest;
    0: result := SAbout;
  else result := '';
  end;
end;

function TPTSaveDlgEditor.GetVerbCount: Integer;  begin result := 2; end;
{=========================================================}



{-- TPTSplitterEditor ------------------------------------}
type TPTSplitterEditor = class(TDefaultEditor)
       procedure ExecuteVerb(index: Integer);  override;
       function GetVerb(index: Integer): String;  override;
       function GetVerbCount: Integer;  override;
     end;

procedure TPTSplitterEditor.ExecuteVerb(index: Integer);
var s: TPTSplitter;
begin
  s := Component as TPTSplitter;
  case index of
    0: FPTAbout.TPTFrmAbout.ExecuteCtl( CTLPACK_NAME, CTLPACK_COPYRIGHT, Component.ClassName, CTLPACK_VERSION, CTLPACK_PATCH );
    1: s.Position := (s.Extent - s.SplitterWidth) div 2;
    2: s.SwapPanes(TRUE);
    3: s.SetActivePane(s.Pane1.Index);
    4: s.SetActivePane(s.Pane2.Index);
  end;
end; {TPTSplitterEditor.ExecuteVerb}

function TPTSplitterEditor.GetVerb(index: Integer): String;
begin
  case index of
    0: result := SAbout;
    1: result := SCenterPanes;
    2: result := SSwapPanes;
    3: result := SActivatePane1;
    4: result := SActivatePane2;
  else result := '';
  end;
end; {TPTSplitterEditor.GetVerb}

function TPTSplitterEditor.GetVerbCount: Integer;
  begin result := 5; end;
{== END TPTSplitterEditor ================================}


{-- TOpenDialogEditor ------------------------------------}
type TOpenDialogEditor = class(TDefaultEditor)
       procedure ExecuteVerb(index: Integer);  override;
       function GetVerb(index: Integer): String;  override;
       function GetVerbCount: Integer;  override;
     end;

procedure TOpenDialogEditor.ExecuteVerb(index: Integer);
begin
  (Component as TOpenDialog).Execute;
end;

function TOpenDialogEditor.GetVerb(index: Integer): String;
begin
  case index of
    0: result := STest;
  else result := '';
  end;
end; {TOpenDialogEditor.GetVerb}

function TOpenDialogEditor.GetVerbCount: Integer;
  begin result := 1; end;
{== END TOpenDialogEditor ================================}


{$IFDEF VCL50}
type
  TPlasmatechCategory = class(TPropertyCategory)
  public
    class function Name: String; override;
    class function Description: String; override;
  end; {TPlasmatechCategory}

{ TPlasmatechCategory }
class function TPlasmatechCategory.Name: String;
begin
  Result := ' Plasmatech';
end;

class function TPlasmatechCategory.Description: String;
begin
  Result := 'Items added by Plasmatech controls';
end;

type
  PLASMATECH_CATEGORY = TPlasmatechCategory;
  LEGACY_CATEGORY = TLegacyCategory;
{$ENDIF}

{$IFDEF VCL60PLUS}
const
  PLASMATECH_CATEGORY = ' Plasmatech';
  LEGACY_CATEGORY: string = sLegacyCategoryName;
{$ENDIF VCL60PLUS}


{__________________________________________________________________________________________________}
procedure RegisterComponentEditors( components: array of TComponentClass;  editor: TComponentEditorClass );
var i: Integer;
begin
  for i := Low(components) to High(components) do
    RegisterComponentEditor( components[i], editor );
end;

procedure Register;
begin
  RegisterComponents( CTLPACK_PAGENAME, [TPTShellTree, TPTShellList, TPTShellCombo,
                                         TPTOpenDlg, TPTSaveDlg, TPTFolderBrowseDlg,
                                         TPTFrame, TPTGroup,
                                         TPTSplitter, TPTImageCombo,
                                         TPTSysFolderDlg,
                                         TPTCombobox,
                                         TPTTreeView, TPTListView] );
  RegisterNoIcon( [TPTPane] );

  RegisterPropertyEditor( TypeInfo(TPTShellLocator), nil, '', TPTShellLocatorEditor );
  RegisterPropertyEditor( TypeInfo(TCSIDL), nil, '', TCSIDLEditor );

  RegisterComponentEditor( TPTSysFolderDlg, TPTSysFolderDlgEditor );
  RegisterComponentEditor( TPTFolderBrowseDlg, TPTFolderBrowseDlgEditor );
  RegisterComponentEditor( TPTOpenDlg, TPTOpenDlgEditor );
  RegisterComponentEditor( TPTSaveDlg, TPTSaveDlgEditor );
  RegisterComponentEditor( TPTSplitter, TPTSplitterEditor );

  RegisterComponentEditors( [TPTShellTree, TPTShellList, TPTShellCombo,
                             TPTFrame, TPTGroup,
                             TPTImageCombo, TPTCombobox,
                             TPTTreeView, TPTListView],
                            TPTAboutEditor );

  RegisterComponentEditor( TOpenDialog, TOpenDialogEditor );

{$IFNDEF CBUILDER} {$IFNDEF DELPHI6}
  RegisterPropertyEditor(TypeInfo(String), TPTFileDlg, 'Filter', TFilterProperty);
  RegisterPropertyEditor(TypeInfo(String), TPTShellList, 'Filter', TFilterProperty);
{$ENDIF} {$ENDIF}

{$IFDEF VCL50PLUS}
  RegisterPropertyEditor(TypeInfo(TPTFrameStyle), nil, '', TPTFrameStyleProperty);

  // TPTShellCombo
  RegisterPropertiesInCategory(PLASMATECH_CATEGORY, TPTCustomShellCombo,
    ['ShellTree', 'ShellList', 'IndentPixels', 'Options']);

  // TPTShellList
  RegisterPropertiesInCategory(PLASMATECH_CATEGORY, TPTCustomShellList,
    ['Options', 'Folder', 'FileFilter', 'HeaderSortIconOption',
     'OnAddItem', 'OnDeleteItem', 'OnPopupHint', 'OnDblClickOpen', 'OnCustomDrawSh',
     'OnCustomDrawShEx', 'OnFillComplete', 'OnFillStart', 'OnFolderChanged']);

  // TPTShellTree
  RegisterPropertiesInCategory(PLASMATECH_CATEGORY, TPTCustomShellTree,
    ['SelectedItem', 'SelectedFolder', 'SelectedPathName', 'ShTreeData', 'BaseFolder',
     'ShellList', 'Options', 'OnAddItem', 'OnDeleteItem', 'OnInsertItem', 'OnPopupHint',
     'OnCustomDrawSh', 'OnCustomDrawShEx', 'OnFillComplete', 'OnFillStart']);

  // TPTFileDlg
  RegisterPropertiesInCategory(PLASMATECH_CATEGORY, TPTFileDlg,
    ['DefaultExt', 'Title', 'Options', 'Filter', 'FilterIndex', 'FormWidth', 'FormHeight',
     'FormWindowState', 'FormSplitterPos', 'HelpContext', 'HistoryList', 'InitialDir',
     'OnAddListItem', 'OnAddTreeItem', 'OnAddComboItem', 'OnInitialized', 'OnLvCustomDrawSh',
     'OnLvCustomDrawShEx', 'OnTvCustomDrawSh', 'OnTvCustomDrawShEx', 'OnFormClose', 'OnFormShow',
     'OnFolderChanged', 'OnSelectionChanged', 'OnTypeChanged']);

  // TPTOpenDlg
  // TPTSaveDlg

  // TPTFolderBrowseDlg
  RegisterPropertiesInCategory(PLASMATECH_CATEGORY, TPTFolderBrowseDlg,
    ['Title', 'FormWidth', 'FormHeight', 'FormWindowState', 'BaseFolder', 'Options', 'OnAddItem',
     'OnFormClose', 'OnFormShow', 'OnSelChange', 'OnInitialized', 'OnTvCustomDrawSh',
     'OnTvCustomDrawShEx']);

  // TPTFrame
  RegisterPropertiesInCategory(PLASMATECH_CATEGORY, TPTCustomFrame,
    ['Alignment', 'DefaultDrawing', 'FrameSpace', 'FrameStyle', 'OnPaint']);

  // TPTGroup
  RegisterPropertiesInCategory(PLASMATECH_CATEGORY, TPTCustomGroup,
    ['Alignment', 'DefaultDrawing', 'FrameSpace', 'FrameStyle', 'OnPaint']);

  // TPTSplitter
  RegisterPropertiesInCategory(PLASMATECH_CATEGORY, TPTSplitter,
    ['FullDragMode', 'Proportional', 'Position', 'Style', 'SplitterWidth', 'Pane1Color',
     'Pane1FrameStyle', 'Pane1MinSize', 'Pane2Color', 'Pane2FrameStyle', 'Pane2MinSize',
     'OnChange', 'OnResize', 'OnSplitterDrag', 'OnSplitterDrop']);

  // TPTComboBox
  RegisterPropertiesInCategory(PLASMATECH_CATEGORY, TPTCustomCombobox,
    ['OnDeleteItem', 'OnCloseUp', 'OnSelEndCancel', 'OnSelEndOk']);

  // TPTImageCombo
  RegisterPropertiesInCategory(PLASMATECH_CATEGORY, TPTCustomImageCombo,
    ['AutoSizeHeight', 'IndentPixels', 'ImageList']);

  // TPTSysFolderDlg
  RegisterPropertiesInCategory(PLASMATECH_CATEGORY, TPTSysFolderDlg,
    ['Domain', 'Options', 'Title', 'OnInitialized', 'OnSelChanged']);

  // TPTListView
  RegisterPropertiesInCategory(PLASMATECH_CATEGORY, TPTCustomListView,
    ['HeaderSortDisplayMode', 'HeaderDefaultDrawing',
     'OnPTCustomDraw', 'OnPTCustomDrawEx', 'OnItemContextMenu']);

  // TPTTreeView
  RegisterPropertiesInCategory(PLASMATECH_CATEGORY, TPTCustomTreeView,
    ['OnPTCustomDraw', 'OnPTCustomDrawEx', 'OnNodeContextMenu']);

  // General
  RegisterPropertiesInCategory(LEGACY_CATEGORY,
    ['OnCustomDrawSh', 'OnCustomDrawShEx']);
{$ENDIF}
end;

end.